home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / nrpas13.zip / BESSJ1.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-29  |  968b  |  27 lines
  1. FUNCTION bessj1(x: real): real;
  2. VAR
  3.    ax,xx,z: real;  y,ans,ans1,ans2: double;
  4. FUNCTION sign(x: real): real;
  5.    BEGIN
  6.       IF x >= 0.0 THEN sign := 1.0
  7.       ELSE sign := -1.0;
  8.    END;
  9. BEGIN
  10.    IF (abs(x) < 8.0) THEN BEGIN
  11.       y := sqr(x);
  12.       ans1 := x*(72362614232.0+y*(-7895059235.0+y*(242396853.1
  13.          +y*(-2972611.439+y*(15704.48260+y*(-30.16036606))))));
  14.       ans2 := 144725228442.0+y*(2300535178.0+y*(18583304.74
  15.          +y*(99447.43394+y*(376.9991397+y*1.0))));
  16.       bessj1 := sngl(ans1/ans2)  END
  17.    ELSE BEGIN
  18.       ax := abs(x); z := 8.0/ax; y := sqr(z); xx := ax-2.356194491;
  19.       ans1 := 1.0+y*(0.183105e-2+y*(-0.3516396496e-4
  20.          +y*(0.2457520174e-5+y*(-0.240337019e-6))));
  21.       ans2 := 0.04687499995+y*(-0.2002690873e-3
  22.          +y*(0.8449199096e-5+y*(-0.88228987e-6+y*0.105787412e-6)));
  23.       ans := sqrt(0.636619772/ax)*(cos(xx)*ans1
  24.          -z*sin(xx)*ans2)*sign(x);
  25.       bessj1 := sngl(ans)  END
  26. END;
  27.